/*
    REDLisp - interpreter/compiler for new dialect of LISP called REDLISP
    Copyright (C) 2006  Rudolf Olah

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*/

#include "logic.h"


dObject *
dIfCall (dList *expList, dList *env, dList *env2)
{
  // If function arguments construction
  dList *ifList = new dList ();
  // If looks like: (if test true false)
  if (expList->size < 2)
    return new dError ("if: requires test returning T or nil");
  // Item is the test
  dObject *item = process ((*expList)[1], env, env2);
  ifList->append (item);
  for (int i = 2; i < expList->size; i++)
    ifList->append ((*expList)[i]);
  item = dIf (ifList);
  return process (item, env, env2);
}

dObject *
dIf (dList *args)
{
  if (args == 0 || args->size < 2 || args->size > 3)
    return new dError ("if requires 2 arguments; symbol and list");
  else if ((*args)[0]->type == 'e')
    return (*args)[0];
  if (isNil ((*args)[0]))
    {
      if (args->size == 3)
	return (*args)[2];
      else
	return nil;
    }
  return (*args)[1];
}

dObject *
dMakeLambda (dList *args)
{
  //debug (args);
  printf ("args->size == %i\n", args->size);
  if (args->size == 1 || ((*args)[1]->type != 'l'))
    return new dError ("function: requires 1 list followed by a body");
  dList *body = new dList ();
  int i = 2;
  if ((*args)[2]->type == 's')
    i = 3;
  if ((*args)[i] != 0 && !((dList*)(*args)[i])->empty ())
    {
      for (; i < args->size; i++)
	body->append ((*args)[i]);
    }
  else
    body->append (nil);
  if ((*args)[2]->type == 's')
    return new dLambda ((dList*)(*args)[1], body, (dString*)(*args)[2]);
  else
    return new dLambda ((dList*)(*args)[1], body);
}

dObject *
dEquals (dList *args)
{
  if (args == 0 || args->size != 2)
    return new dError ("eq: requires two string, two number or two list arguments");
  bool returnVal = false;
  dObject *arg1 = (*args)[0], *arg2 = (*args)[1];
  if (arg1->type == 's' && arg2->type == 's')
    returnVal = *(dString*)arg1 == *(dString*)arg2;
  else if (isNumber (arg1) && isNumber (arg2))
    returnVal = *(dNumber*)arg1 == *(dNumber*)arg2;
  else if (arg1->type == 'S' && arg2->type == 'S')
    returnVal = *(dSymbol*)arg1 == *(dSymbol*)arg2;
  else
    return nil;
  //return new dError ("eq: requires two string, two number or two list arguments");
  if (returnVal)
    return T;
  else
    return nil;
}

dObject *
dNotEquals (dList *args)
{
  dObject *returned = dEquals (args);
  if (returned->type == 'e')
    return new dError ("!eq: requires two string, two number or two list arguments");
  else if (returned->type == 'S') // It's true, return false
    return nil;
  return T;
}

dObject *
dMoreThan (dList *args)
{
  if (args == 0 || args->size != 2)
    return new dError ("> requires two string, two number or two list arguments");
  bool returnVal = false;
  dNode *temp = args->first;
  if (checkArgs ("%s %s", args) == 0)
    returnVal = *(dString*)temp->car > *(dString*)temp->cdr->car;
  else if (checkArgs ("%n %n", args) == 0)
    returnVal = *(dNumber*)temp->car > *(dNumber*)temp->cdr->car;
  else
    return new dError ("> requires two string, two number or two list arguments");
  if (returnVal)
    return T;
  else
    return nil;
}

dObject *
dLessThan (dList *args)
{
  if (args == 0 || args->size != 2)
    return new dError ("< requires two string, two number or two list arguments");
  bool returnVal = false;
  dNode *temp = args->first;
  if (checkArgs ("%s %s", args) == 0)
    returnVal = *(dString*)temp->car < *(dString*)temp->cdr->car;
  else if (checkArgs ("%n %n", args) == 0)
    returnVal = *(dNumber*)temp->car < *(dNumber*)temp->cdr->car;
  else
    return new dError ("< requires two string, two number or two list arguments");
  if (returnVal)
    return T;
  else
    return nil;
}

dObject *
dMoreThanEquals (dList *args)
{
  if (args == 0 || args->size != 2)
    return new dError (">= requires two string, two number or two list arguments");
  bool result = false;
  if (checkArgs ("%s %s", args) == 0)
    result = dMoreThan (args) == T || dEquals (args) == T;
  else if (checkArgs ("%n %n", args) == 0)
    result = dMoreThan (args) == T || dEquals (args) == T;
  else
    return new dError (">= requires two string, two number or two list arguments");
  if (result)
    return T;
  return nil;
}

dObject *
dLessThanEquals (dList *args)
{
  if (args == 0 || args->size != 2)
    return new dError ("<= requires two string, two number or two list arguments");
  bool result = false;
  if (checkArgs ("%s %s", args) == 0)
    result = dLessThan (args) == T || dEquals (args) == T;
  else if (checkArgs ("%n %n", args) == 0)
    result = dLessThan (args) == T || dEquals (args) == T;
  else
    return new dError ("<= requires two string, two number or two list arguments");
  if (result)
    return T;
  return nil;
}

dObject *
dAnd (dList *args)
{
  if (args == 0)
    return T;
  bool currentVal = true;
  dNode *current = args->first;
  while (current != 0)
    {
      if ((currentVal && current->car == T) == false || current->car == 0)
	return nil;
      else
	current = current->cdr;
    }
  return T;
}

dObject *
dOr (dList *args)
{
  if (args == 0)
    return nil;
  dNode *current = args->first;
  while (current != 0)
    {
      if (current->car == T || current->car == 0)
	return T;
      else
	current = current->cdr;
    }
  return nil;
}

dObject *
dXor (dList *args)
{
  if (args == 0 || args->first->cdr == 0)
    return new dError ("xor requires at least 2 arguments");
  bool foundTrue = false;
  dNode *current = args->first;
  while (current != 0)
    {
      if (current->car == T)
	{
	  if (foundTrue)
	    return nil;
	  else
	    foundTrue = true;
	}
      current = current->cdr;
    }
  if (foundTrue)
    return T;
  return nil;
}

dObject *
dNot (dList *args)
{
  if (args == 0 || args->size > 1)
    return new dError ("not requires 1 argument");
  if ((*args)[0] == T)
    return nil;
  return T;
}
